home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / talk_sou / my_libra / myintern.uni < prev    next >
Text File  |  1992-04-20  |  3KB  |  145 lines
  1. unit MyInternetMenu;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7.     procedure InitInternetMenu;
  8.     procedure FinishInternetMenu;
  9.     procedure AddInternetCommand (s: str255);
  10.     function GetInternetCommand (themenu, theitem: integer): str255;
  11.     procedure RemoveInternetCommand (themenu, theitem: integer);
  12.     procedure SetXMenu (themenu, theitem: integer);
  13.  
  14. implementation
  15.  
  16.     uses
  17.         AppGlobals, MyUtils, MyPreferences, MyFMenus;
  18.  
  19.     var
  20.         send_to_mh, remove_mh: menuHandle;
  21.         modified: boolean;
  22.  
  23.     procedure AddInternetCommand (s: str255);
  24.         var
  25.             i, c: integer;
  26.             lessthan: boolean;
  27.             mi: str255;
  28.     begin
  29.         c := CountMItems(send_to_mh);
  30.         i := 1;
  31.         lessthan := false;
  32.         while (i <= c) and not lessthan do begin
  33.             GetItem(send_to_mh, i, mi);
  34.             lessthan := (s <= mi);
  35.             if not lessthan then
  36.                 i := i + 1;
  37.         end;
  38.         if not lessthan or (s <> mi) then begin
  39.             InsMenuItem(send_to_mh, 'fred', i - 1);
  40.             InsMenuItem(remove_mh, 'fred', i - 1);
  41.             SetItem(send_to_mh, i, s);
  42.             SetItem(remove_mh, i, s);
  43.         end;
  44.         modified := true;
  45.     end;
  46.  
  47.     procedure SetXMenu (themenu, theitem: integer);
  48.     begin
  49.         SetIDItemEnable(themenu, theitem, CountMItems(send_to_mh) > 0);
  50.     end;
  51.  
  52.     function GetInternetCommand (themenu, theitem: integer): str255;
  53.         var
  54.             s: str255;
  55.     begin
  56.         GetItem(send_to_mh, theitem, s);
  57.         GetInternetCommand := s;
  58.     end;
  59.  
  60.     procedure RemoveInternetCommand (themenu, theitem: integer);
  61.     begin
  62.         DelMenuItem(send_to_mh, theitem);
  63.         DelMenuItem(remove_mh, theitem);
  64.         modified := true;
  65.     end;
  66.  
  67.     procedure SaveInternetMenu;
  68.         type
  69.             intPtr = ^integer;
  70.             intHandle = ^intPtr;
  71.         var
  72.             oe, ooe: OSErr;
  73.             vrn: integer;
  74.             dirID: longInt;
  75.             i, rn, count, len: integer;
  76.             s: str255;
  77.             h: handle;
  78.     begin
  79.         if modified then begin
  80.             count := CountMItems(send_to_mh);
  81.             len := SizeOf(integer);
  82.             for i := 1 to count do begin
  83.                 GetItem(send_to_mh, i, s);
  84.                 len := len + Length(s) + 1;
  85.             end;
  86.             h := NewHandle(len);
  87.             if h <> nil then begin
  88.                 intHandle(h)^^ := count;
  89.                 len := 2;
  90.                 for i := 1 to count do begin
  91.                     GetItem(send_to_mh, i, s);
  92.                     BlockMove(@s, ptr(longInt(h^) + len), Length(s) + 1);
  93.                     len := len + Length(s) + 1;
  94.                 end;
  95.                 SetPrefsResource(to_rsrc, to_strh_id, h);
  96.             end;
  97.             modified := false;
  98.         end;
  99.     end;
  100.  
  101.     procedure SetSaveMenu (themenu, theitem: integer);
  102.     begin
  103.         SetIDItemEnable(themenu, theitem, modified);
  104.     end;
  105.  
  106.     procedure LoadInternetMenu;
  107.         type
  108.             intPtr = ^integer;
  109.             intHandle = ^intPtr;
  110.         var
  111.             i, rn, count: integer;
  112.             s: str255;
  113.             h: handle;
  114.     begin
  115.         rn := GetPrefsResource(to_rsrc, to_strh_id, h);
  116.         if h <> nil then begin
  117.             count := intHandle(h)^^;
  118.             for i := 1 to count do begin
  119.                 GetIndString(s, to_strh_id, i);
  120.                 AddInternetCommand(s);
  121.             end;
  122.             DisposHandle(h);
  123.         end;
  124.         if rn <> -1 then
  125.             CloseResFile(rn);
  126.     end;
  127.  
  128.     procedure InitInternetMenu;
  129.     begin
  130.         send_to_mh := NewMenu(M_InternetTo, 'Send To');
  131.         InsertMenu(send_to_mh, -1);
  132.         remove_mh := NewMenu(M_RemoveTo, 'Remove');
  133.         InsertMenu(remove_mh, -1);
  134.         LoadInternetMenu;
  135.         modified := false;
  136.         SetFBoth(CSaveMenu, @SaveInternetMenu, @SetSaveMenu);
  137.         SetFSetMenu(CXInternet, @SetXMenu);
  138.         SetFSetMenu(CXRemove, @SetXMenu);
  139.     end;
  140.  
  141.     procedure FinishInternetMenu;
  142.     begin
  143.     end;
  144.  
  145. end.